home *** CD-ROM | disk | FTP | other *** search
/ Freelog 15 / FREELOG 15.ISO / WebMaster / Perl / PERL5106.ZIP / perl5 / ntt / TEST.BAT < prev   
Encoding:
DOS Batch File  |  1996-01-31  |  3.4 KB  |  147 lines
  1. @rem = '
  2. @echo off
  3. if exist perl.exe goto perlhere
  4. echo Cannot run without perl.exe in current directory!!    Did you build it?
  5. pause
  6. goto endofperl
  7. :perlhere
  8. if exist perlglob.exe goto perlglobhere
  9. echo Cannot run without perlglob.exe in current directory!!    Did you build it?
  10. pause
  11. goto endofperl
  12. :perlglobhere
  13. perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
  14. goto endofperl
  15. @rem ';
  16.  
  17. #Portions (C) 1995 Microsoft Corporation. All rights reserved. 
  18. #        Developed by hip communications inc., http://info.hip.com/info/
  19.  
  20.  
  21. # This is written in a peculiar style, since we're trying to avoid
  22. # most of the constructs we'll be testing for.
  23.  
  24. $| = 1;
  25.  
  26. if ($ARGV[0] eq '-v') {
  27.     $verbose = 1;
  28.     shift;
  29. }
  30.  
  31.  
  32. # WYT 1995-05-02
  33. chdir 'ntt' if -f 'ntt/TESTNT';
  34.  
  35.  
  36. if ($ARGV[0] eq '') {
  37. #    @ARGV = split(/[ \n]/,
  38. #      `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t lib/*.t`);
  39. #      `ls base/*.ntt comp/*.ntt cmd/*.ntt io/*.ntt op/*.ntt lib/*.ntt`);
  40.  
  41. # WYT 1995-05-02 wildcard expansion,
  42. #    `perl -e "print( join( ' ', \@ARGV ) )" base/*.ntt comp/*.ntt cmd/*.ntt io/*.ntt op/*.ntt lib/*.ntt nt/*.ntt`);
  43.  
  44. # WYT 1995-06-01 removed all dependency on perlglob
  45. # WYT 1995-11-28 hacked up to cope with braindead Win95 console.
  46.  
  47.     push( @ARGV, `dir/s/b base` );
  48.     push( @ARGV, `dir/s/b comp` );
  49.     push( @ARGV, `dir/s/b cmd` );
  50.     push( @ARGV, `dir/s/b io` );
  51.     push( @ARGV, `dir/s/b op` );
  52.     push( @ARGV, `dir/s/b lib` );
  53.     push( @ARGV, `dir/s/b nt` );
  54.  
  55.     grep( chomp, @ARGV );
  56.     @ARGV = grep( /\.ntt$/, @ARGV );
  57.     grep( s/.*ntt\\//, @ARGV );
  58. }
  59.  
  60. $sharpbang = 0;
  61.  
  62. $bad = 0;
  63. $good = 0;
  64. $total = @ARGV;
  65. while ($test = shift) {
  66.     if ($test =~ /^$/) {
  67.     next;
  68.     }
  69.     $te = $test;
  70. # chop off 'ntt' extension
  71.     chop($te);
  72.     chop($te);
  73.     chop($te);
  74.     print "$te" . '.' x (15 - length($te));
  75.     if ($sharpbang) {
  76.     open(results,"./$test |") || (print "can't run.\n");
  77.     } else {
  78.         $switch = '';
  79. #    open(results,"./perl$switch $test |") || (print "can't run.\n");
  80.     open(results,"perl$switch $test |") || (print "can't run.\n");
  81.     }
  82.     $ok = 0;
  83.     $next = 0;
  84.     while (<results>) {
  85.     if ($verbose) {
  86.         print $_;
  87.     }
  88.         unless (/^#/||/^$/) {
  89.         if (/^1\.\.([0-9]+)/) {
  90.         $max = $1;
  91.         $totmax += $max;
  92.         $files += 1;
  93.         $next = 1;
  94.         $ok = 1;
  95.         } else {
  96.         $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
  97.         if (/^ok (.*)/ && $1 == $next) {
  98.             $next = $next + 1;
  99.         } else {
  100.             $ok = 0;
  101.         }
  102.         }
  103.     }
  104.     }
  105.     $next = $next - 1;
  106.     if ($ok && $next == $max) {
  107.     print "ok\n";
  108.     $good = $good + 1;
  109.     } else {
  110.     $next += 1;
  111.     print "FAILED on test $next\n";
  112.     $bad = $bad + 1;
  113.     $_ = $test;
  114.     if (/^base/) {
  115.         die "Failed a basic test--cannot continue.\n";
  116.     }
  117.     }
  118. }
  119.  
  120. if ($bad == 0) {
  121.     if ($ok) {
  122.     print "All tests successful.\n";
  123.     } else {
  124.     die "FAILED--no tests were run for some reason.\n";
  125.     }
  126. } else {
  127.     $pct = sprintf("%.2f", $good / $total * 100);
  128.     if ($bad == 1) {
  129.     warn "Failed 1 test, $pct% okay.\n";
  130.     } else {
  131.     die "Failed $bad/$total tests, $pct% okay.\n";
  132.     }
  133. }
  134.  
  135.  
  136. # WYT 1995-05-03 times not implemented.
  137. #($user,$sys,$cuser,$csys) = times;
  138. #print sprintf("u=%g  s=%g  cu=%g  cs=%g  files=%d  tests=%d\n",
  139. #    $user,$sys,$cuser,$csys,$files,$totmax);
  140.  
  141. #`del /f Cmd_while.tmp Comp.try null 2>NULL`;
  142.  
  143. unlink 'Cmd_while.tmp', 'Comp.try', 'null';
  144.  
  145. __END__
  146. :endofperl
  147.